home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2001 May / SGI Freeware 2001 May - Disc 3.iso / dist / fw_expect.idb / usr / freeware / bin / dislocate.z / dislocate
Text File  |  1999-01-26  |  7KB  |  343 lines
  1. #!/usr/freeware/bin/expect --
  2. # dislocate - allow disconnection and reconnection to a background program
  3. # Author: Don Libes, NIST
  4.  
  5. exp_version -exit 5.1
  6.  
  7. # The following code attempts to intuit whether cat buffers by default.
  8. # The -u flag is required on HPUX (8 and 9) and IBM AIX (3.2) systems.
  9. if [file exists $exp_exec_library/cat-buffers] {
  10.     set catflags "-u"
  11. } else {
  12.     set catflags ""
  13. }
  14. # If this fails, you can also force it by commenting in one of the following.
  15. # Or, you can use the -catu flag to the script.
  16. #set catflags ""
  17. #set catflags "-u"
  18.  
  19. set escape \035            ;# control-right-bracket
  20. set escape_printable "^\]"
  21.  
  22. set pidfile "~/.dislocate"
  23. set prefix "disc"
  24. set timeout -1
  25. set debug_flag 0
  26.  
  27. while {$argc} {
  28.     set flag [lindex $argv 0]
  29.     switch -- $flag \
  30.     "-catu" {
  31.         set catflags "-u"
  32.         set argv [lrange $argv 1 end]
  33.         incr argc -1
  34.     } "-escape" {
  35.         set escape [lindex $argv 1]
  36.         set escape_printable $escape
  37.         set argv [lrange $argv 2 end]
  38.         incr argc -2
  39.     } "-debug" {
  40.         log_file [lindex $argv 1]
  41.         set debug_flag 1
  42.         set argv [lrange $argv 2 end]
  43.         incr argc -2
  44.     } default {
  45.         break
  46.     }
  47. }
  48.  
  49. # These are correct from parent's point of view.
  50. # In child, we will reset these so that they appear backwards
  51. # thus allowing following two routines to be used by both parent and child
  52. set  infifosuffix ".i"
  53. set outfifosuffix ".o"
  54.  
  55. proc infifoname {pid} {
  56.     global prefix infifosuffix
  57.  
  58.     return "/tmp/$prefix$pid$infifosuffix"
  59. }
  60.  
  61. proc outfifoname {pid} {
  62.     global prefix outfifosuffix
  63.  
  64.     return "/tmp/$prefix$pid$outfifosuffix"
  65. }
  66.  
  67. proc pid_remove {pid} {
  68.     global date proc
  69.  
  70.     say "removing $pid $proc($pid)"
  71.  
  72.     unset date($pid)
  73.     unset proc($pid)
  74. }
  75.  
  76. # lines in data file looks like this:
  77. # pid#date-started#argv
  78.  
  79. # allow element lookups on empty arrays
  80. set date(dummy) dummy;    unset date(dummy)
  81. set proc(dummy) dummy;    unset proc(dummy)
  82.  
  83. # load pidfile into memory
  84. proc pidfile_read {} {
  85.     global date proc pidfile
  86.  
  87.     if [catch {open $pidfile} fp] return
  88.  
  89.     #
  90.     # read info out of file
  91.     #
  92.  
  93.     say "reading pidfile"
  94.     set line 0
  95.     while {[gets $fp buf]!=-1} {
  96.         # while pid and date can't have # in it, proc can
  97.         if [regexp "(\[^#]*)#(\[^#]*)#(.*)" $buf junk pid xdate xproc] {
  98.             set date($pid) $xdate
  99.             set proc($pid) $xproc
  100.         } else {
  101.             puts "warning: inconsistency in $pidfile line $line"
  102.         }
  103.         incr line
  104.     }
  105.     close $fp
  106.     say "read $line entries"
  107.  
  108.     #
  109.     # see if pids and fifos are still around
  110.     #
  111.  
  112.     foreach pid [array names date] {
  113.         if {$pid && [catch {exec /bin/kill -0 $pid}]} {
  114.             say "$pid no longer exists, removing"
  115.             pid_remove $pid
  116.             continue
  117.         }
  118.  
  119.         # pid still there, see if fifos are
  120.         if {![file exists [infifoname $pid]] || ![file exists [outfifoname $pid]]} {
  121.             say "$pid fifos no longer exists, removing"
  122.             pid_remove $pid
  123.             continue
  124.         }
  125.     }
  126. }
  127.  
  128. proc pidfile_write {} {
  129.     global pidfile date proc
  130.  
  131.     say "writing pidfile"
  132.  
  133.     set fp [open $pidfile w]
  134.     foreach pid [array names date] {
  135.         puts $fp "$pid#$date($pid)#$proc($pid)"
  136.         say "wrote $pid#$date($pid)#$proc($pid)"
  137.     }
  138.     close $fp
  139. }
  140.  
  141. proc fifo_pair_remove {pid} {
  142.     global date proc prefix
  143.  
  144.     pidfile_read
  145.     pid_remove $pid
  146.     pidfile_write
  147.  
  148.     catch {exec rm -f [infifoname $pid] [outfifoname $pid]}
  149. }
  150.  
  151. proc fifo_pair_create {pid argdate argv} {
  152.     global prefix date proc
  153.  
  154.     pidfile_read
  155.     set date($pid) $argdate
  156.     set proc($pid) $argv
  157.     pidfile_write
  158.  
  159.     mkfifo [infifoname $pid]
  160.     mkfifo [outfifoname $pid]
  161. }
  162.  
  163. proc mkfifo {f} {
  164.     if [file exists $f] {
  165.         say "uh, fifo already exists?"
  166.         return
  167.     }
  168.  
  169.     if 0==[catch {exec mkfifo $f}] return        ;# POSIX
  170.     if 0==[catch {exec mknod $f p}] return
  171.     # some systems put mknod in wierd places
  172.     if 0==[catch {exec /usr/etc/mknod $f p}] return    ;# Sun
  173.     if 0==[catch {exec /etc/mknod $f p}] return    ;# AIX, Cray
  174.     puts "Couldn't figure out how to make a fifo - where is mknod?"
  175.     exit
  176. }
  177.  
  178. proc child {argdate argv} {
  179.     global catflags infifosuffix outfifosuffix
  180.  
  181.     disconnect
  182.  
  183.     # these are backwards from the child's point of view so that
  184.     # we can make everything else look "right"
  185.     set  infifosuffix ".o"
  186.     set outfifosuffix ".i"
  187.     set pid 0
  188.  
  189.     eval spawn $argv
  190.     set proc_spawn_id $spawn_id
  191.  
  192.     while {1} {
  193.         say "opening [infifoname $pid] for read"
  194.          spawn -open [open "|cat $catflags < [infifoname $pid]" "r"]
  195.         set in $spawn_id
  196.  
  197.         say "opening [outfifoname $pid] for write"
  198.         spawn -open [open [outfifoname $pid] w]
  199.         set out $spawn_id
  200.  
  201.         fifo_pair_remove $pid
  202.  
  203.         say "interacting"
  204.         interact {
  205.             -u $proc_spawn_id eof exit
  206.             -output $out
  207.             -input $in
  208.         }
  209.  
  210.         # parent has closed connection
  211.         say "parent closed connection"
  212.         catch {close -i $in}
  213.         catch {wait -i $in}
  214.         catch {close -i $out}
  215.         catch {wait -i $out}
  216.  
  217.         # switch to using real pid
  218.         set pid [pid]
  219.         # put entry back
  220.         fifo_pair_create $pid $argdate $argv
  221.     }
  222. }
  223.  
  224. proc say {msg} {
  225.     global debug_flag
  226.  
  227.     if !$debug_flag return
  228.  
  229.     if [catch {puts "parent: $msg"}] {
  230.         send_log "child: $msg\n"
  231.     }
  232. }
  233.  
  234. proc escape {} {
  235.     # export process handles so that user can get at them
  236.     global in out
  237.  
  238.     puts "\nto disconnect, enter: exit (or ^D)"
  239.     puts "to suspend, press appropriate job control sequence"
  240.     puts "to return to process, enter: return"
  241.     interpreter
  242.     puts "returning ..."
  243. }
  244.  
  245. # interactively query user to choose process, return pid
  246. proc choose {} {
  247.     global index date
  248.  
  249.     while 1 {
  250.         send_user "enter # or pid: "
  251.         expect_user -re "(.*)\n" {set buf $expect_out(1,string)}
  252.         if [info exists index($buf)] {
  253.             set pid $index($buf)
  254.         } elseif [info exists date($buf)] {
  255.             set pid $buf
  256.         } else {
  257.             puts "no such # or pid"
  258.             continue
  259.         }
  260.         return $pid
  261.     }
  262. }
  263.  
  264. if {$argc} {
  265.     # initial creation occurs before fork because if we do it after
  266.     # then either the child or the parent may have to spin retrying
  267.     # the fifo open.  Unfortunately, we cannot know the pid ahead of
  268.     # time so use "0".  This will be set to the real pid when the
  269.     # parent does its initial disconnect.  There is no collision
  270.     # problem because the fifos are deleted immediately anyway.
  271.  
  272.     set datearg [exec date]
  273.     fifo_pair_create 0 $datearg $argv
  274.  
  275.     set pid [fork]
  276.     say "after fork, pid = $pid"
  277.     if $pid==0 {
  278.         child $datearg $argv
  279.     }
  280.     # parent thinks of child as pid==0 for reason given earlier
  281.     set pid 0
  282. }
  283.  
  284. say "examining pid"
  285.  
  286. if ![info exists pid] {
  287.     global fifos date proc
  288.  
  289.     say "pid does not exist"
  290.  
  291.     pidfile_read
  292.  
  293.     set count 0
  294.     foreach pid [array names date] {
  295.         incr count
  296.     }
  297.  
  298.     if $count==0 {
  299.         puts "no connectable processes"
  300.         exit
  301.     } elseif $count==1 {
  302.         puts "one connectable process: $proc($pid)"
  303.         puts "pid $pid, started $date($pid)"
  304.         send_user "connect? \[y] "
  305.         expect_user -re "(.*)\n" {set buf $expect_out(1,string)}
  306.         if {$buf!="y" && $buf!=""} exit
  307.     } else {
  308.         puts "connectable processes:"
  309.         set count 1
  310.         puts " #   pid      date started      process"
  311.         foreach pid [array names date] {
  312.             puts [format "%2d %6d  %.19s  %s" \
  313.                 $count $pid $date($pid) $proc($pid)]
  314.             set index($count) $pid
  315.             incr count
  316.         }
  317.         set pid [choose]
  318.     }
  319. }
  320.  
  321. say "opening [outfifoname $pid] for write"
  322. spawn -noecho -open [open [outfifoname $pid] w]
  323. set out $spawn_id
  324.  
  325. say "opening [infifoname $pid] for read"
  326. spawn -noecho -open [open "|cat $catflags < [infifoname $pid]" "r"]
  327. set in $spawn_id
  328.  
  329. puts "Escape sequence is $escape_printable"
  330.  
  331. proc prompt1 {} {
  332.     global argv0
  333.  
  334.     return "$argv0[history nextid]> "
  335. }
  336.  
  337. interact {
  338.     -reset $escape escape
  339.     -output $out
  340.     -input $in
  341. }
  342.  
  343.